home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 17 / CU Amiga Magazine's Super CD-ROM 17 (1997)(EMAP Images)(GB)[!][issue 1997-12].iso / CUCD / Online / TASC / rexx / TASC.thor < prev   
Text File  |  1997-09-27  |  16KB  |  627 lines
  1. /* $VER: TASC.thor 1.8 (08.08.97)
  2.  *
  3.  *
  4.  * Concept & Original Scripts by: Kirk Strauser <kstrauser@gxl.com>
  5.  * and Adrian Knight <ajk@dial.pipex.com>
  6.  *   
  7.  * Rewritten by: Andy Macklin <badger@toadhall.u-net.com>
  8.  */
  9.  
  10.  
  11. /* Read the config file & set up defalts if it isn't there */
  12. if open(cfg,'Env:thor/TASC.cfg',r) then do
  13.    do until eof(cfg)
  14.        lin=readln(cfg)
  15.        parse var lin id ':' V
  16.        V=strip(V)
  17.        if upper(left(id,6))='DELMSG' then
  18.           delmsg=V
  19.        if upper(left(id,3))='URG' then
  20.           urg=V
  21.        if upper(left(id,6))='MAILHD' then
  22.           mailhd=V
  23.        if upper(left(id,6))='NEWSHD' then
  24.           newshd=V
  25.        if upper(left(id,6))='GLOBPM' then
  26.           GlobPM=V
  27.        if upper(left(id,10))='POSTMASTER' then
  28.           Postmaster=V
  29.        if upper(left(id,8))='DATABASE' then
  30.           spamdb=V
  31.        if upper(left(id,8))='SRCHBODY' then
  32.           srchbody=V
  33.        if upper(left(id,6))='TRACER' then
  34.           tracer=V
  35.        if upper(left(id,8))='TRACETMP' then
  36.           tracetmp=V
  37.        if upper(left(id,7))='TRACEFI' then
  38.           tracefi=V
  39.        if upper(left(id,8))='TRACELEN' then
  40.           tracelen=V
  41.     end
  42.     call close(cfg)
  43. end
  44. else do
  45.     delmsg='N'
  46.     urg='N'
  47.     mailhd='Email spam'
  48.     newshd='Usenet spam/mail fraud'
  49.     globPM='N'
  50.     Postmaster=''
  51.     spamdb='spam.db'
  52.     srchbody='N'
  53.     tracer='N'
  54.     tracetmp='traceroute.tmp'
  55.     tracefi='spamtrace.db'
  56.     tracelen='3000'
  57. end
  58.  
  59. /*=======================================================*/
  60. /* You're not supposed to change anything from here down */
  61. /*=======================================================*/
  62.  
  63. Parse ARG CLIARG
  64. CLIARG=upper(CLIARG)
  65. if CLIARG~='AUTO' & CLIARG~='' then do
  66.     say 'Template: TASC.thor [AUTO/S]'
  67.     say 'Run this script from within Thor'
  68.     exit
  69. end
  70.  
  71. options results
  72. options failat 31
  73.  
  74. CDB_MAIL                = 1   /* Private mail conference. */
  75. rcd=''
  76. rl=1
  77.  
  78. thorport = address()
  79. if left(thorport, 5) ~= 'THOR.' then do
  80.   say 'Cannot find thorport.'
  81.   exit
  82. end
  83.  
  84. if ~show('p', 'BBSREAD') then do
  85.   address command
  86.   "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  87.   "WaitForPort BBSREAD"
  88. end
  89.  
  90. if open(A,'env:thor/thorpath') then do
  91.     THORP=READLN(A)
  92.     call close(A)
  93. end
  94. else do
  95.     address (thorport)
  96.     requestnotify text '"Unable to find/read env:thor/BBSdataPath"' BT '"_OK"'
  97.     exit
  98. end
  99.  
  100. if open(T,'env:thor/BBSDataPath') then do
  101.     BBSP=READLN(T)
  102.     call close(T)
  103. end
  104. else do
  105.     address (thorport)
  106.     requestnotify text '"Unable to find/read env:thor/BBSdataPath"' BT '"_OK"'
  107.     exit
  108. end
  109.  
  110. address(thorport)
  111.  
  112. CURRENTMSG stem MSG
  113. if (rc ~= 0) then call oops("No current message.")
  114.  
  115. SAVEMESSAGE CURRENT FILE "T:tasc.tempfile"
  116. if(rc ~= 0) then call oops("Can't save current message.")
  117.  
  118. IF Open(A,'T:tasc.tempfile','r') = 0 THEN
  119.         call oops("Couldn't open temporary file.")
  120.  
  121.  
  122. i='1'
  123. flame.=''
  124. toaddr.=''
  125. do until hder=''
  126.     hder= readln(A)
  127.     if upper(left(hder,8)) = 'RECEIVED' then do        
  128.         Call Recd
  129.     end
  130.     if upper(left(hder,7)) = 'MESSAGE' then do
  131.         Call Mess
  132.     end
  133.     if upper(left(hder,6)) = 'RETURN' then do
  134.         Call Rtn
  135.     end
  136.     if upper(left(hder,5)) = 'REPLY' then do
  137.         Call Rply
  138.     end
  139.     if upper(left(hder,5)) = 'FROM:' then do
  140.         Call Frm
  141.     end
  142.     if upper(left(hder,5)) = 'PATH:' then do
  143.         Call Pth
  144.     end
  145.     if upper(left(hder,4)) = 'NNTP' then do
  146.         Call nntp
  147.     end
  148.     if index(hder,'ender')~=0 then do /* Sender or authenticated sender line in these headers */
  149.         Call Sndr
  150.     end
  151. end
  152. if upper(srchbody)='Y' then do until eof(A)
  153.     hder=readln(A)
  154.     if index(hder,'@')~=0 then do
  155.         Call Atsign
  156.     end
  157.     if index(hder,'ttp://')~=0 | index(hder,'www.')~=0 then do
  158.         Call Http
  159.     end
  160. end
  161. call close(A)
  162. /* Set the values for the Mailserver */
  163. Call Radd
  164. /* Parse out the next level of the internet heirachy to complain to */
  165. Call Boss
  166. /* remove unneeded addresses (if appropriate)*/
  167. if CLIARG~='AUTO' then do
  168.     Call Update
  169. end
  170. /* Check for known bad ISPs, undeliverable addresses or specific addresses for abuse. */
  171. Call Undeliverable
  172.  
  173. address BBSREAD
  174.  
  175. READBRMESSAGE bbsname '"'MSG.BBSNAME'"' confname '"'MSG.CONFNAME'"' msgnr MSG.MSGNR headstem HEADTAGS textstem TEXTTAGS 
  176. if (rc ~= 0) then call oops
  177.  
  178. getconfdata bbsname '"'MSG.BBSNAME'"' confname '"'MSG.CONFNAME'"' stem CONFDATA
  179. if (rc ~= 0) then call oops
  180.  
  181. UNIQUEMSGFILE bbsname '"'MSG.BBSNAME'"' stem tmp
  182. if (rc ~= 0) then call oops
  183.  
  184. /* Build the outgoing message */
  185.  
  186. if Postmaster~='' then do
  187.     address command
  188.     'echo "From: postmaster@'||Postmaster||'" > t:tasc.tempH'
  189.     'Echo "" >> t:tasc.tempH'
  190. end
  191. if ~bittst(CONFDATA.FLAGS,CDB_MAIL) then do
  192.     address command 'Type "'||THORP||'rexx/SpamNewsHeader" >> T:tasc.tempH'
  193.     end
  194. else do
  195.     address command 'Type "'||THORP||'rexx/SpamMailHeader" >> T:tasc.tempH'
  196. end
  197. address command 'Join t:tasc.tempH t:tasc.tempfile as 'tmp.NAME
  198. if (rc ~= 0) then call oops("Unable to build message file.")
  199.  
  200. /* Choose the addresses from the header & the hotlist to send the complaint to */
  201. if CLIARG~='AUTO' then do
  202.     Call Chooser
  203. end
  204. else do
  205.     Call AutoR
  206. end
  207.  
  208. call WriteMessage
  209.  
  210. if (rc ~= 0) then call oops
  211.  
  212. if upper(tracer)='Y' then do
  213.     address (thorport)
  214.     do r= 1 to toaddr.count
  215.         if left(toaddr.r,1)='+' then do
  216.             toaddr.count=toaddr.count-1
  217.         end
  218.     end
  219.     Requestlist Instem toaddr outstem route dragselect multiselect title '"Send tracceroute requests for:"'
  220.     if rc=0 then do
  221.             Call Tr
  222.     end
  223. end
  224.  
  225. if delmsg='Y' then do
  226.     address(bbsread)
  227.     UPDATEBRMESSAGE '"'MSG.BBSNAME'"' '"'MSG.CONFNAME'"' msgnr MSG.MSGNR SETDELETED
  228. end
  229.  
  230. call tidy
  231.  
  232. Recd:
  233. rcd.rl=hder
  234. rl=1-rl
  235. parse VAR hder gubbins 'from' addss 'by' remains
  236. parse VAR addss rnme '(' brak ')'
  237. if index(rnme,'[')~=0 then do
  238.     parse VAR rnme rnme '[' brak
  239. end
  240. netnum=brak
  241. if index(brak,'(')~=0 then do
  242.     parse VAR brak xtra '(' netnum ')'
  243. end
  244. if index(brak,'[')~=0 then do
  245.     parse VAR brak xtra '[' netnum ']'
  246. end
  247. if index(brak,'@')~=0 then do
  248.     parse VAR brak gubbins '@' remains
  249.     if index(remains,'[')~=0 then do
  250.         parse VAR remains xtra '[' gubbins
  251.     end
  252.     if index(remains,'(')~=0 then do
  253.         parse VAR remains xtra '(' gubbins
  254.     end
  255.     if index(remains,' ')~=0 then do
  256.         parse VAR remains xtra ' ' gubbins
  257.     end
  258. end
  259. rnme=strip(rnme,'B','.]) ')
  260. netnum=strip(netnum,'B','.]) ')
  261. xtra=strip(xtra,'B','.]) ')
  262. return
  263.  
  264. Mess:
  265. /* Message ID may contain a valid _Real_ domain to complain to */
  266. parse VAR hder gubbins '@' mnme '>'
  267. flame.i='Msg-ID:'||strip(mnme)
  268. i=i+1
  269. return
  270.  
  271. Rtn:
  272. /* Return Path might contain a valid _Real_ domain to complain to */
  273. parse VAR hder gubbins '@' rtnme '>'
  274. flame.i='Return Path:'||strip(rtnme)
  275. i=i+1
  276. return
  277.  
  278. Rply:
  279. /* Reply-to: might contain a valid _Real_ domain to complain to */
  280. parse VAR hder gubbins '@' rpnme ' ' remains
  281. flame.i='Reply-To:'||strip(rpnme)
  282. i=i+1
  283. return
  284.  
  285. Frm:
  286. /* From: might contain a valid _Real_ domain to complain to. I wish :( */
  287. parse VAR hder gubbins '@' fnme '>'
  288. flame.i='From:'||strip(fnme)
  289. i=i+1
  290. return
  291.  
  292. Sndr:
  293. parse VAR hder gubbins 'sender' remains '@' sendr ' '
  294. flame.i='Sender:'||strip(sendr,'T','.)>] ;:')
  295. i=i+1
  296. return
  297.  
  298. Atsign:
  299. parse VAR hder gubbins '@' hder
  300. parse VAR hder Atsgn ' ' gubbins
  301. Atsgn=strip(Atsgn,T,'.>) ')
  302. flame.i='Text(Email):'||Atsgn
  303. i=i+1
  304. return
  305.  
  306. Http:
  307. if index(hder,'ttp://')~=0 then do
  308.     parse VAR hder gubbins 'ttp://' hder
  309. end
  310. if index(hder,'www.')~=0 then do
  311.     parse VAR hder gubbins 'www.' hder
  312. end
  313. parse VAR hder htp '/' gubbins
  314. if index(htp,' ')~=0 then do
  315.     parse VAR htp htp ' ' gubbins
  316. end
  317. P1=lastpos('.',htp)
  318. P2=substr(htp,P1+1)
  319. if datatype(P2,'N')=1 then do
  320.     htp= '['||htp||']'
  321. end
  322. htp=strip(htp,T,' .>)')
  323. flame.i='Text(http):'||htp
  324. i=i+1
  325. return
  326.  
  327. Pth:
  328. /* Search the path: header for possible addresses (news spam only) */
  329. P1=lastpos('!',hder)
  330. P2=lastpos('!',hder,P1-1)
  331. P1=substr(hder,P2+1)
  332. parse VAR P1 parth '!' gubbins
  333. flame.i='Path:'||strip(parth)
  334. i=i+1
  335. return
  336.  
  337. nntp:
  338. /* Just in case there is an nntp-posting-host header in the news spam */
  339. parse VAR hder gubbins ': ' nntpnme
  340. flame.i='NNTP-Host:'||strip(nntpnme)
  341. i=i+1
  342. return
  343.  
  344. Radd:
  345. if (rnme~='RNME' & rnme~='') then do
  346.     flame.i='Mailserver:'||rnme
  347.     i=i+1
  348. end
  349. if (netnum~='NETNUM' & netnum~='') then do
  350.     flame.i='Mailserver:['||netnum||']'
  351.     i=i+1
  352. end
  353. if (xtra~='XTRA' & xtra~='') then do
  354.     flame.i='Mailserver:'||xtra
  355.     i=i+1
  356. end
  357. return
  358.  
  359. AutoR:
  360. j=1
  361. toaddr.count=0
  362. do m=1 to (i-1)
  363.     parse VAR flame.m hder ':' tnme
  364.     if bittst(confdata.flags,CDB_Mail) then do
  365.         /* A Mail message */
  366.         if hder='Msg-ID' then do
  367.             call autoadd
  368.             end
  369.         if hder='Mailserver' then do
  370.             call autoadd
  371.             end
  372.         end
  373.     else do
  374.         if hder='NNTP-Host' then do
  375.             call autoadd
  376.             end
  377.         if hder='Path' then do
  378.             call autoadd
  379.             end
  380.     end
  381. end
  382. if toaddr.count=0 then do
  383.     address (thorport)
  384.     requestnotify text '"No addresses suitable for autoreply option"' BT '"_OK"'
  385.     call tidy
  386. end
  387. else do
  388.     drop flame.
  389.     flame.count=toaddr.count
  390.     do i=1 to toaddr.count
  391.         flame.i=toaddr.i
  392.     end
  393. end
  394. return
  395.  
  396.  
  397. autoadd:
  398. toaddr.j='auto:'||tnme
  399. j=j+1
  400. toaddr.count=toaddr.count+1
  401. return
  402.  
  403. Boss:
  404. /* Add the option to complain further up the internet hierachy */
  405. k=i-1
  406. do j=1 to k
  407.     parse VAR flame.j gubbins ':' lwr '.' hghr
  408.     if left(lwr,1)~='[' then do     /*Not an IP number */
  409.         if index(hghr,'.')~=0 then do
  410.             flame.i='Parent of '||gubbins||':'||hghr
  411.             i=i+1
  412.         end
  413.     end
  414. end
  415. return
  416.  
  417. FakeBoss:
  418. /* Add the option to complain further up the internet hierachy, after
  419.    ignoring a faked Received: line.
  420. */
  421. do j=toaddr.count to z
  422.     parse VAR toaddr.j gubbins ':' lwr '.' hghr
  423.     if left(lwr,1)~='[' then do     /*Not an IP number */
  424.         if index(hghr,'.')~=0 then do
  425.             z=z+1
  426.             toaddr.z='Parent of '||gubbins||':'||hghr
  427.         end
  428.     end
  429. end
  430. return
  431.  
  432. Update:
  433. m=1
  434. toaddr.count=0
  435. do j=1 to (i-1)
  436.     parse VAR flame.j gubbins ':' jtmp
  437.     uniq=1
  438.     do k=(j+1) to i
  439.         parse VAR flame.k gubbins ':' ktmp
  440.         if jtmp = ktmp then do
  441.             uniq=0
  442.         end
  443.         if jtmp = '' then do
  444.             uniq=0
  445.         end
  446.     end
  447.     if uniq=1 then do
  448.         toaddr.m=flame.j
  449.         toaddr.count=toaddr.count+1
  450.         m=m+1
  451.     end
  452. end
  453. return
  454.  
  455. Undeliverable:
  456. if open(db,BBSP||'db/'||spamdb,r) then do
  457.     a=0
  458.     wrong.=''
  459.     correct.=''
  460.     fakehdr=''
  461.     do until eof(db)
  462.         lin=readln(db)
  463.         a=a+1
  464.         parse VAR lin wrong.a '->' correct.a
  465.     end
  466.     wrong.count=a
  467.     do m=1 to toaddr.count
  468.         parse VAR toaddr.m nme ':' oldaddr
  469.         do a=1 to wrong.count
  470.             if upper(oldaddr)=upper(wrong.a) then do
  471.                 if upper(correct.a)~='UNDELIVERABLE' then do
  472.                     if index(correct.a,'@')~=0 then do
  473.                         toaddr.m='+'||nme||'(Redirected):'||correct.a
  474.                     end
  475.                     else do
  476.                         if upper(correct.a)~='FAKED' then
  477.                         toaddr.m=nme||'(Redirected):'||correct.a
  478.                     end
  479.                     if index(correct.a,'8-}')~=0 then do
  480.                         toaddr.m=nme||' 8-} :'||oldaddr
  481.                     end
  482.                     if upper(correct.a)='FAKED' then do
  483.                        if index(nme,'Mail')~=0 then do
  484.                            toaddr.m='-'||nme||'*(Faked)*:'||oldaddr
  485.                            if fakehdr='' then do
  486.                                hder=rcd.rl
  487.                                fakehdr=oldaddr
  488.                                Call Recd
  489.                                z=toaddr.count+1
  490.                                if (rnme~='RNME' & rnme~='') then do
  491.                                   toaddr.z=nme||'*(Not Faked)*:'||rnme
  492.                                   z=z+1
  493.                                end
  494.                                if (xtra~='XTRA' & xtra~='') then do
  495.                                   toaddr.z=nme||'*(Not Faked)*:'||xtra
  496.                                   z=z+1
  497.                                end
  498.                                if (netnum~='NETNUM' & netnum~='') then do
  499.                                   toaddr.z=nme||'*(Not Faked)*:'||'['||netnum||']'
  500.                                end
  501.                                Call Fakeboss
  502.                                toaddr.count=z
  503.                            end
  504.                            else do
  505.                                warn=':'||oldaddr||' & '||fakehdr||' are faked'
  506.                                toaddr.m='-'||nme||warn
  507.                            end
  508.                         end
  509.                         else do
  510.                             toaddr.m='-'||nme||'*(Faked)*'
  511.                         end
  512.                     end
  513.                 end
  514.                 else do
  515.                     toaddr.m='-'||nme||':('||oldaddr||')'||correct.a
  516.                 end
  517.             end
  518.         end
  519.     end
  520. end
  521. call close(db)
  522. return
  523.  
  524. WriteMessage:
  525.    address BBSREAD
  526.    EVE_ENTERMSG = 0
  527.    drop EVENT.
  528.    EVENT.TONAME = ''
  529.    Do j=1 to flame.count
  530.        if globPM~='Y' then do
  531.          parse VAR flame.j tnme ':' tadd
  532.          EVENT.TONAME = EVENT.TONAME  || strip(strip(tnme,B,'+'),T,'8-} ') || ','
  533.          end
  534.        else do
  535.          EVENT.TONAME = EVENT.TONAME  || 'Postmaster,'
  536.          end
  537.    end
  538.    EVENT.TONAME = strip(EVENT.TONAME,T,',')
  539.    EVENT.TOADDR = ''
  540.    Do j=1 to flame.count
  541.        parse VAR flame.j tnme ':' tadd
  542.        if left(tnme,1)='+' then
  543.           EVENT.TOADDR = EVENT.TOADDR || tadd|| ','
  544.        else do
  545.           if left(tnme,1)='-' then
  546.             NOP
  547.           else
  548.             EVENT.TOADDR = EVENT.TOADDR || 'postmaster@'|| tadd ||','
  549.        end
  550.    end
  551.    EVENT.TOADDR=strip(EVENT.TOADDR,T,',')
  552.    if ~bittst(CONFDATA.FLAGS,CDB_MAIL) then do
  553.         EVENT.SUBJECT = newshd
  554.         end
  555.    else do
  556.         EVENT.SUBJECT = mailhd
  557.    end
  558.    EVENT.CONFERENCE = 'EMail'
  559.    EVENT.MSGFILE = tmp.FILEPART
  560.    if urg='Y' then do
  561.         EVENT.URGENT = 1
  562.         end
  563.    else do
  564.         EVENT.URGENT=0
  565.    end
  566.    WRITEBREVENT bbsname '"'MSG.BBSNAME'"' event EVE_ENTERMSG stem EVENT
  567. return
  568.  
  569. Chooser:
  570. /* Here's where the additional recipients like the IRS get added to the options */
  571. DROP flame.
  572. if open(A,THORP||'rexx/spamaddr','r') then do
  573.     DO WHILE ~Eof(A)
  574.         spama=readln(A)
  575.         if left(spama,1)='+' then do
  576.             i=toaddr.count+1
  577.             toaddr.i=spama
  578.             toaddr.count=toaddr.count+1
  579.         end
  580.     END
  581. end
  582. address(Thorport)
  583. Requestlist Instem toaddr outstem flame dragselect multiselect title '"Complain to"'
  584. IF (RC > 0) THEN DO
  585.    REQUESTNOTIFY TEXT '"No Addresses Selected"' BT '"_Ok"'
  586.    address command 'delete >nil: '||tmp.NAME
  587.    call tidy
  588.    EXIT
  589. END
  590. return
  591.  
  592. Tr:
  593. if open(T,'env:thor/BBSDataPath') then do
  594.     BBSP=READLN(T)
  595.     call close(T)
  596. end
  597. else do
  598.     address (thorport)
  599.     requestnotify text '"Unable to find/read env:thor/BBSdataPath"' BT '"_OK"'
  600.     return
  601. end
  602. do j=1 to route.count
  603.     address command
  604.     parse VAR route.j gubbins ':' addr
  605.     'echo "echo Finding route for: '||addr||' >> '||BBSP||'db/'||tracefi||'" >> '||BBSP||'db/'||tracetmp
  606.     'echo "traceroute '||addr||' >> '||BBSP||'db/'||tracefi||'" >> '||BBSP||'db/'||tracetmp
  607.     'echo "echo Done >> '||BBSP||'db/'||tracefi||'" >> '||BBSP||'db/'||tracetmp
  608. end
  609. 'protect '||BBSP||'db/'||tracetmp||' +s'
  610. return
  611.  
  612. oops:
  613.   PARSE ARG errmsg
  614.   if errmsg = '' then do
  615.     if address() = "BBSREAD" then errmsg=BBSREAD.LASTERROR
  616.     else errmsg=THOR.LASTERROR
  617.   end
  618.   address(thorport)
  619.   REQUESTNOTIFY TEXT '"' errmsg '"' BT '"_Abort"'
  620.   call tidy
  621. return
  622.  
  623.  
  624. tidy:
  625.   address command 'delete >nil: T:tasc.temp#?'
  626. exit
  627.